perm filename EXPHD.FAI[IRC,LCS] blob
sn#175505 filedate 1977-03-30 generic text, type T, neo UTF8
;MACROS TO MAKE FAIL EASIER
IFNDEF STANSW,<↓STANSW←←0>
DEFINE CAT $(A,B){A$B}
↓P←←17
FOR @$ I←0,16
< AC.$I←I
>
$←400000
.PLEVEL←←0
.SLEVEL←←0
;SUBROUTINE DECLARATIONS. MAKES MACROS FOR SYMBOLS REPRESENTING ARGUMENTS
DEFINE NSUBR(NAME,X1,X2,X3,X4,X5,X6)
{ BEGIN NAME
INTERN NAME
XLIST
GLOBAL .PLEVEL
GLOBAL .SLEVEL
.SLEVEL←←.SLEVEL+1
CAT(.SBR,→.SLEVEL)←←.PLEVEL
.PLEVEL←←.PLEVEL+1
IFDIF <><X1>{ DEFARG(X1,→.PLEVEL)
.PLEVEL←.PLEVEL+1
IFDIF <><X2>{ DEFARG(X2,→.PLEVEL)
.PLEVEL←.PLEVEL+1
IFDIF <><X3>{ DEFARG(X3,→.PLEVEL)
.PLEVEL←.PLEVEL+1
IFDIF <><X4>{ DEFARG(X4,→.PLEVEL)
.PLEVEL←.PLEVEL+1
IFDIF <><X5>{ DEFARG(X5,→.PLEVEL)
.PLEVEL←.PLEVEL+1
IFDIF <><X6>{ DEFARG(X6,→.PLEVEL)
.PLEVEL←.PLEVEL+1
}}}}}}
LIST
↓NAME: ;}
;DEFINE AN ARGUMENT
DEFINE DEFARG(NAME,LEVEL)
{ DEFINE NAME { LEVEL-.PLEVEL(17)}}
;END OF SUBROUTINE
DEFINE SUBREND
{ .PLEVEL←←CAT(.SBR,→.SLEVEL)
.SLEVEL←←.SLEVEL-1
BLOCK 0
BEND }
;GENERATE SUBROUTINE CALL (DOES THE RIGHT THING WITH SYMBOLIC ARGUEMENTS)
DEFINE CALL(NAME,X1,X2,X3,X4,X5,X6){
XLIST
GLOBAL .SLEVEL,.PLEVEL
.SLEVEL←←.SLEVEL+1
CAT(.SBR,→.SLEVEL)←←.PLEVEL
IFDIF <><X1>{PUSH 17,X1↔.PLEVEL←.PLEVEL+1
IFDIF <><X2>{PUSH 17,X2↔.PLEVEL←.PLEVEL+1
IFDIF <><X3>{PUSH 17,X3↔.PLEVEL←.PLEVEL+1
IFDIF <><X4>{PUSH 17,X4↔.PLEVEL←.PLEVEL+1
IFDIF <><X5>{PUSH 17,X5↔.PLEVEL←.PLEVEL+1
IFDIF <><X6>{PUSH 17,X6↔.PLEVEL←.PLEVEL+1
}}}}}}
PUSHJ P,NAME
.PLEVEL←←CAT(.SBR,→.SLEVEL)
.SLEVEL←←.SLEVEL-1
LIST}
;PUSH SOMETHING ONTO STACK
DEFINE PUSHP(ARG)
< PUSH P,ARG
.PLEVEL←←.PLEVEL+1
>
DEFINE POPP(ARG)
< POP P,ARG
.PLEVEL←←.PLEVEL-1
>
DEFINE PUSHACS
< PUSHJ P,PUSHIT↑
GLOBAL .PLEVEL
.PLEVEL←←.PLEVEL+20
>
DEFINE POPACS
< PUSHJ P,POPIT↑
GLOBAL .PLEVEL
.PLEVEL←←.PLEVEL-20
>
DEFINE SETQ(VAR,LIST){CALL(LIST)↔DAC 1,VAR}
;RETURN FROM AN N-ARGUMENT SUBROUTINE CALL.
IFNDEF POP0J
< DEFINE POP0J <POPJ 17,>
DEFINE POP1J<JRST POP1J.↑>
DEFINE POP2J<JRST POP2J.↑>
DEFINE POP3J<JRST POP3J.↑>
DEFINE POP4J<JRST POP4J.↑>
DEFINE POP5J<JRST POP5J.↑>
>
;ACCUMULATOR AND TEMPORARY DATA MANAGEMENT.
; FOR @$ I←0,17{↓AC$I:0↔}
; DEFINE SAVAC $(N){LAC[XWD 2,AC2]↔BLT AC$N}
; DEFINE GETAC (N){LAC[XWD AC,2]↔BLT N}
DEFINE ACCUMULATORS(LIST){ACPTR←←2
FOR AC⊂(LIST)<AC←ACPTR
ACPTR←←ACPTR+1↔>}
DEFINE DECLARE (LIST){
FOR VARNAM⊂(LIST)<VARNAM: 0↔>}
;FATAL ERROR MESSAGE.
IFNDEF FATAL.
< DEFINE FATAL(STR){PUSHJ 17,FATAL.↑↔JFCL [ASCIZ/STR/]}
>
IFNDEF WARN.
< DEFINE WARN(STR){PUSHJ 17,WARN.↑↔JFCL [ASCIZ/STR/]}
>
;CHAIN TOGETHER INITIALIZING CODE
DEFINE INITCODE
<IFAVL .INITLINK
< GLOBAL .INITLINK
PUSHJ P,.+2
JRST .INITLINK
↑.INITLINK←←.-2
;> ↑.INITLINK←←.
>
;CHAIN TOGETHER BIT TABLES
DEFINE BITDEFS(BITS)
<IFNDEF .BTLNK < .BTLNK←←0
;> .BTLNK
.BTLNK←←.BTLNK*1000000+$.
.BTABL←←$.
FOR BIT⊂(BITS)
<IFIDN <><BIT>< 0
;> RADIX50 0,BIT
> BLOCK =36+.BTABL-$.
>
DEFINE TAIL
<DOINIT:
IFDEF .INITLINK < PUSHJ P,.INITLINK
> IFDEF .BTLNK < EXTERNAL $M
MOVE [.BTLNK]
SKIPE [$M]
MOVEM $M+3
POP0J
>>
;OPDEFS
;ONE OF BGB'S WHICH I LIKE
OPDEF GO [JRST]
;MAKE RAID KNOW THE FOLLOWING
OPDEF HALT [HALT]
OPDEF JRSTF [JRST 2,]
DEFINE FIX
<PRINTX FIX DOESN'T WORK OUTSIDE OF STANFORD ! >
IODEND←←20000
EXTERNAL JOBFF,JOBREL,JOBSA,JOBREN,JOBSYM,JOBDDT,JOBOPC
;Sigh...
DEFINE IDBP
< PRINTX Better change that IDBP to IDPB
IDPB >